{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  ContML.FreshMon
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Monad supplying fresh identifiers.
--
--------------------------------------------------------------------------------


module ContML.FreshMon
  ( 

    Mon
  , runMon

  , fresh
  , refresh

  ) where

import ContML.VarId
import ContML.Types

import Control.Applicative


newtype Mon a = Mon { getMon :: Int -> (a,Int) }

instance Functor Mon where
  fmap f ma = Mon $ \s -> let (a,s1) = getMon ma s in (f a, s1)

instance Applicative Mon where
  pure a    = Mon $ \s -> (a,s)
  af <*> av = Mon $ \s -> let (f,s1) = getMon af s
                              (a,s2) = getMon av s1
                          in (f a,s2)

instance Monad Mon where
  return = pure
  ma >>= k = Mon $ \s -> let (a,s1) = getMon ma s in getMon (k a) s1

{-
freshK :: Type -> Mon VarId
freshK ty = Mon $ \i -> (VarId ('k':show i) ty, i+1)

freshVar :: Type -> Mon VarId
freshVar ty = Mon $ \i -> (VarId ('x':show i) ty, i+1)
-}

fresh :: Char -> Type -> Mon VarId
fresh c ty = Mon $ \i -> (VarId (c:show i) ty, i+1)


-- | Add a fresh subscript to the variable name.
--
refresh :: VarId -> Mon VarId
refresh (VarId ss ty) = Mon $ \i -> (VarId (ss ++ '.':show i) ty, i+1)

runMon :: Mon a -> a
runMon ma = fst $ getMon ma 1000
